perm filename TVFONT.FAI[XGP,BGB] blob
sn#038128 filedate 1973-05-11 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00031 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00004 00002 TITLE TVFONT - TELEVISION TO FONT - BGB - JANUARY 1973.
C00006 00003 DATA AREAS
C00008 00004 INITIALIZATION---------------------------------------------------
C00010 00005 NSUBR(TTY)TVFONT TELETYPE COMMAND JUMP TABLE----------------------
C00020 00006 MORE COMMAND TABLE --- LETTERS ----------------------------------
C00024 00007 EXTENDED COMMANDS
C00032 00008 NSUBR SEGTV
C00034 00009 NSUBR KILLER
C00036 00010 NSUBR(NEXIMG)-----------------------------------------------------
C00038 00011 NSUBR(MAKCUT)-----------------------------------------------------
C00040 00012 NSUBR(GETSIX)-----------------------------------------------------
C00042 00013 NSUBR MKGLYPH MOVE POLYGON TO PREVIOUS IMAGE
C00047 00014 NSUBR(ASCODE)-----------------------------------------------------
C00048 00015 NSUBR(ADJUST)-----------------------------------------------------
C00052 00016 NSUBR(SCALED)-----------------------------------------------------
C00054 00017 NSUBR FOREACH,OBJ,ROUTINE
C00055 00018 NSUBR DOMOVE,X,Y
C00058 00019 NSUBR(CLOSEV,OBJ,AX,AY) FIND CLOSEST VERTEX TO (AX,AY) FROM OBJ
C00062 00020 NSUBR(FINDV)
C00063 00021 NSUBR(MIDPNT,VERTEX)
C00064 00022 NSUBR(MUNGV,VERTEX)
C00066 00023 NSUBR(NEWVRT)
C00068 00024 NSUBR(ROTPOLY,POLYGON,ANGLE,CX,CY)
C00071 00025 NSUBR IMGSRT
C00073 00026 NSUBR READFONT
C00074 00027 NSUBR LIMITS,LEVEL
C00075 00028 NSUBR DEXTEND,VERTEX
C00078 00029 NSUBR NARROW,LVL,K
C00080 00030 NSUBR NARRW2,LVL,K1,K2
C00084 00031 NSUBR VECMAG,DX,DY
C00085 ENDMK
C⊗;
TITLE TVFONT - TELEVISION TO FONT - BGB - JANUARY 1973.
;CONTROL FLAGS.
INTERN FLGSIX,FLGARC,FLGBK,PUSHIT,POPIT
FLGKRK: 0 ;ENABLE KRAKAUER TREE.
FLGSIX: -1 ;SIX BIT TELEVISON.
FLGARC: 0 ;ENABLE MAKE ARC SMOOTHING.
FLGBK: -1 ;ENABLE BABY KILLER.
VCUT: -14 ;VECTOR DISPLAY CONTRAST THRESHOLD.
FLGWED: 0 ;DISPLAY WINGED EDGED IMAGE.
FLGBGB: 0 ;RUNNING UNDER A BGB PPPN.
FLGRAR: 0 ;DISPLAY RECIPROCAL ARC RADIALS.
;-1 BOTH, 0 VIC, +1 ARCS.
FLGKINK:0 ;DISPLAY KINKS.
FLGU: -1 ;KILVIC ENABLE.
NODPY: 0 ;SUPPRESS DISPLAY COMPLETELY
NOGRID: -1 ;SUPPESS GRID
FLGUPD: -1 ;UPDATE FLAG
UPDCON: 6 ;HOW OFTEN TO UPDATE ANYWAY
ARCWID: 0.50
CNTFLG: -1
INTERNAL FLGWED,BLKCNT,ARCWID,FTVSIX,NOGRID,VCUT,HISTO,FILM,UPDCON,HISTOG
INTERNAL FLGRAR,FLGUPD,NODPY,FLGKIN,ARCWID,CNTFLG,SA,TVCLIP
EXTERN MKFONT,SQRT,SIN,COS,REALIN
EXTERN DPYGRI,CROP,SX,SY,QBLK,DPYBUF,DEL,LIGHTP,DPYPAK,RCXY,STADPY,DPYBLK
EXTERN MAG,DPYIMG,DPYHIS,PAK,FNTPAK,TVHELP,INCDPY,MKBITS
BITDEF{,,,TMPBIT,WASP,NORBIT,EASBIT,SOUBIT,WESBIT,ARCBIT,HOLBIT,FILBIT,IBIT,LBIT,PBIT,FBIT,EBIT,VBIT}
;DATA AREAS
;CAREYE STANDARD TV FILE IS =10496 WORDS LONG, 24400 OCTAL.
;=10 WORD HEADER, =216 ROWS OF =288 COLUMNS OF 6 BITS PER PIXEL.
;=118 WORD TRAILER.
HI ←← 400000
↓$←400000
PAC ← HI ↔ HI ←← HI + =1728 ;PICTURE ACCUMULATOR.
VSEG← HI ↔ HI ←← HI + =1729 ;VERTICAL SEGMENTS.
HSEG← HI ↔ HI ←← HI + =1736 ;HORIZONTAL SEGMENTS.
HI ←← HI + =86 ;NEGATIVE ROWS.
HEADER←HI ↔ HI ←← HI + 200 ;NEW HEADER
TVBUF ←HI ↔ HI ←← HI + =10368 ;TV BUFFER 6 BITS PER PIXEL.
HISTO ←HI ↔ HI ←← HI + =64 ;HISTOGRAM.
FTVSIX←HI ↔ HI ←← HI + 1 ;FLAG TV SIX BIT.
FTVHIS←HI ↔ HI ←← HI + 1 ;FLAG TV HISTOGRAM PRESENT.
SKY←←HI
;POINTERS TO TV SEGMENT.
TV: 0
POINT 6,-1,29 ;COLUMN -2.
POINT 6,-1,35 ;COLUMN -1.
COLPTR: FOR I←0,=48{
I+<POINT 6,0,05>↔I+<POINT 6,0,11>↔I+<POINT 6,0,17>
I+<POINT 6,0,23>↔I+<POINT 6,0,29>↔I+<POINT 6,0,35>}
ROWPTR: FOR I←0,=216{
I*=48+TVBUF}
ISAVED: 0
TVSEG: 0
FNTSEG: 0
O(ATTSEG,CALLI 400016)
O(DETSEG,CALLI 400017)
O(SEGNUM,CALLI 400021)
O(CORE2, CALLI 400015)
INTERNAL PATCH
PATCH: BLOCK 100 ;LET'S HEAR IT FOR DEBUGGING!
;INITIALIZATION---------------------------------------------------
OPDEF PPIOT[702B8]
PDL: BLOCK 160
INTERNAL DATPDL,DATPTR
DATPDL: BLOCK =20
DATLEN←←.-DATPDL
DATPTR: BLOCK 1
;START ADDRESS
SA:
MOVE 17,[IOWD 100,PDL]
CALL(MORCOR)
CALL(DOINIT)
SKIPL 1,DATPTR
MOVE 1,[IOWD DATLEN,DATPDL]
MOVEM 1,DATPTR
MOVEI 20↔CRLF↔SOJG .-1
SETZ↔CALLI 24↔HRRZ
CAIE'TVR'
CAIN'BGB'↔SETOM FLGBGB
MOVE 17,[IOWD 100,PDL]
CALL(CROP)
CALL(DPYIMG)
;RE-ENTRY ADDRESS.
MOVEI .↔MOVEM 124
; SKIPN FLGBGB
; OUTSTR[ASCIZ/WARNING: THIS PROGRAM IS STILL EXPERIMENTAL. USE IT AT YOU OWN RISK./]
SETO 1,
TTYUUO 1,6
SKIPL 1
OUTSTR[ASCIZ/This program is design to do display output. Please use a III./]
CALL(TTY)
CALLI 12
;6/12/72----------------------------------------------------------
;TELETYPE COMMAND STATE.
DECLARE{CTRL,META,BUCKY,CHR}
INTERN CTRL,META
NSUBR(TTY)TVFONT TELETYPE COMMAND JUMP TABLE----------------------
;BEGIN TTY
L0: CRLF
PPIOT 2,-=300↔PPIOT 3,3002
L1: OUTCHR["*"]
INCHRW 1
L1B: MOVE 2,1
ASH 2,-7
MOVEM 2,BUCKY
SETZM CTRL
SETZM META
TRZE 1,200↔SETOM CTRL
TRZE 1,400↔SETOM META
CAIGE 1,"A"↔GO @TABLE1(1)
CAIG 1,"Z"↔GO L3
CAIGE 1,"a"↔GO @TABLE2-"Z"-1(1)
CAIG 1,"z"↔GO L3
;{|}<ALTMODE><BS> ARE UNKNOWN
UNIMP: OUTSTR[ASCIZ/??? TYPE 'XHELP' FOR A COMMAND SUMMARY.
/]↔ GO L0
L2: CALL(CROP)↔CALL(DPYIMG)↔GO L1+1
L2B: SKIPN 1↔GO L1+1↔HRRE 1,1↔JUMPL 1,L2C
CAMLE 1,OLD44↔CAMLE 1,JOBREL↔GO L2C
MOVEM 1,QBLK↔CALL(DPYBLK)↔GO L1+1
L2C: OUTSTR[ASCIZ/ ATTEMPT TO SET QBLK TO ADDRESS OUT OF BOUNDS
/]↔ CALL(DPYBLK)↔GO L1+1
SETCNT: MOVEI 10,1
SKIPE CTRL↔ASH 10,1
SKIPE META↔ASH 10,2
SETZM CTRL↔SETZM META
POP0J
TABLE1:
UNIMP ;<NULL>
[CALL(PUSHDAT,QBLK)
CALL(DPYBLK)↔GO L1+1] ;"↓"
[ SETOM CTRL↔INCHRW 1 ;"α"
ALPHA: SKIPE CTRL↔TRO 1,1
SKIPE META↔TRO 1,2
GO L1B]
[SETOM META↔GO ALPHA] ;"β"
[SKIPE 1,QBLK↔NTIME 1,1↔GO L2B] ;"∧"
UNIMP ;"¬"
[SETOM CTRL↔SETOM META↔GO ALPHA] ;"ε"
UNIMP ;"π"
UNIMP ;"λ"
UNIMP ;<TAB>
[CALL(STADPY)↔GO L1+1] ;<LF>
UNIMP ;<VT>
UNIMP ;<FF>
L1 ;<CR>
UNIMP ;"∞"
UNIMP ;"∂"
[SKIPE 1,QBLK↔NGON 1,1↔GO L2B] ;"⊂"
[SKIPE 1,QBLK↔PGON 1,1↔GO L2B] ;"⊃"
[SKIPE 1,QBLK↔EXO 1,1↔GO L2B] ;"∩"
[SKIPE 1,QBLK↔ENDO 1,1↔GO L2B] ;"∪"
UNIMP ;"∀"
UNIMP ;"∃"
[MOVE 1,FILM↔SON 1,1↔JUMPE 1,L2
SON 1,1↔JUMPE 1,L2
CALL(LIMITS,1)↔ADD 1,2↔ADD 3,4 ;"⊗"
ASH 1,-1↔ASH 3,-1↔FLO 1,↔FLO 3,
FSBRI 1,(144.0)↔FSBRI 3,(108.0)
MOVEM 1,SX↔MOVNM 3,SY↔GO L2]
[MOVE 16,DATPDL↔MOVE 1,QBLK↔EXCH 1,(16) ;"↔"
MOVEM 1,QBLK↔CALL(DPYIMG)↔GO L1+1]
UNIMP ;"_"
[ SKIPN 1,QBLK↔GO L2B ;"→"
TESTZ 1,VBIT↔GO[PGON 1,1↔GO EXCLA2]
DAD 1,1
EXCLA2: CALL(SETCNT)↔CALL(DOT)
SON 1,1↔GO L2B]
UNIMP ;"~"
UNIMP ;"≠"
[SKIPE 1,QBLK↔NED 1,1↔GO L2B] ;"≤"
[SKIPE 1,QBLK↔PED 1,1↔GO L2B] ;"≥"
UNIMP ;"≡"
[SKIPE 1,QBLK↔PTIME 1,1↔GO L2B] ;"∨"
L2 ;" "
[SETZM 1,QBLK↔GO L2] ;"!"
UNIMP ;'"'
UNIMP ;"#"
UNIMP ;"$"
UNIMP ;"%"
UNIMP ;"&"
UNIMP ;"'"
[CALL(DOMOVE,[0],[-1.0])↔GO L1] ;"("
[CALL(DOMOVE,[0],[1.0])↔GO L1] ;")"
[MOVE 10,BUCKY↔MOVE MAG↔FMPR[1.5] ;"*"
SOJG 10,$.-1↔MOVEM MAG↔GO L2]
[MOVE 1,FILM↔SOSGE BUCKY↔GO L2B
SON 1,1↔GO $.-3] ;"+"
[SKIPN 1,QBLK↔GO L2B ;","
CALL(SETCNT)
PUSHJ P,[COMMA: CW 1,1↔TEST 1,IBIT↔GO COMMA1
PUSH P,10↔SETOM CTRL↔CALL(NEXIMG)
POP P,10↔MOVE 1,FILM↔SON 1,1
COMMA1: SOJG 10,COMMA↔POP0J]
GO L2B]
[MOVE 10,BUCKY↔MOVE MAG↔FDVR[1.5] ;"-"
SOJG 10,$.-1↔MOVEM MAG↔GO L2]
[SKIPN 1,QBLK↔GO L2B ;"."
CALL(SETCNT)
PUSHJ P,[DOT: CCW 1,1↔TEST 1,IBIT↔GO DOT1
PUSH P,10↔CALL(NEXIMG)↔POP P,10
MOVE 1,FILM↔SON 1,1
DOT1: SOJG 10,DOT↔POP0J]
GO L2B]
[CALL(SETCNT)↔MOVE DEL↔FSC -1 ;"/"
SOJG 10,$.-1↔MOVEM DEL↔GO L2]
UNIMP ;"0"
UNIMP ;"1"
UNIMP ;"2"
UNIMP ;"3"
UNIMP ;"4"
UNIMP ;"5"
UNIMP ;"6"
UNIMP ;"7"
UNIMP ;"8"
UNIMP ;"9"
[CALL(DOMOVE,[1.0],[0])↔GO L1] ;":"
[CALL(DOMOVE,[-1.0],[0])↔GO L1] ;";"
[SKIPN 1,QBLK↔GO L2B ;"<"
TESTZ 1,VBIT↔GO[PGON 1,1↔GO L2B]
NCCW 1,1↔GO L2B]
UNIMP ;"="
[SKIPN 1,QBLK↔GO L2B ;">"
TEST 1,VBIT↔SON 1,1↔GO L2B]
[CALL(COMHLP)↔GO L1] ;"?"
TABLE2:
UNIMP ;"["
[CALL(SETCNT)↔MOVE DEL↔FSC 1 ;"\"
SOJG 10,$.-1↔MOVEM DEL↔GO L2]
UNIMP ;"]"
[CALL(POPDAT)↔MOVEM 1,QBLK
CALL(DPYIMG)↔GO L1+1] ;"↑"
[ SKIPN 1,QBLK↔GO L2B ;"←"
TESTZ 1,VBIT↔GO[PGON 1,1↔GO EXCLA1]
DAD 1,1
EXCLA1: CALL(SETCNT)↔CALL(COMMA)↔SON 1,1↔GO L2B]
;MORE COMMAND TABLE --- LETTERS ----------------------------------
L3: ANDI 1,37↔PUSHJ P,@L4(1)↔CALL(STADPY)↔GO L1
L4: UNKNOWN ;null.
ASCODE ;"A" ASSIGN ASCII CODE TO IMAGE.
SCALED ;"B" EXPAND/CONTRACT
MAKCUT ;"C" MAKE THRESHOLD CUT.
UNKNOWN ;"D"
UNKNOWN ;"E"
FINDV ;"F" LOCATE NEAREST POINT!
GETIMG ;"G" GET IMAGE FROM CHARACTER CODE
DPYHIS ;"H" HISTOGRAM, "αH" ,"βH" BI-MODAL CUT.
CREIN ;"I" INPUT TV PICTURE FROM DISK.
UNKNOWN ;"J" (TO BE JOIN VERTICES)
GENKIL ;"K" KILL QBLK POLYGON.
@[DPYPAK ;"L" DISPLAY BIT ARRAY, "αL" FROM FONT
[OUTSTR[ASCIZ/CHARACTER = /]↔INCHRW 1↔CALL(FNTPAK,1)↔JFCL↔GO DPYPAK]
UNKNOWN↔UNKNOWN](2)
MKGLYPH ;"M,αM" MOVE POLYGON TO NEXT IMAGE, βM MIDPOINT, εM MUNG ON GRID POINT
[SKIPN QBLK↔CALL(NEXIMG)↔POP0J] ;"N" IMAGE RETREAT.
CREOUT ;"O" OUTPUT CAREYE FILE.
PLOTO ;"P" PLOT OUTPUT FILE.
MKFONT ;"Q" CONSTRUCT FONT
@[REGION ;"R" DISPLAY BIT RASTER, αR ROTATE
DOROT↔UNKNOWN↔UNKNOWN](2)
; CAMERA ;"S" SELECT CAMERA, "αS" BCLIP, "βS" TCLIP. (MOVED TO XTEND MODE)
SMOOT. ;"S" DO SMOOTH
TVCAMI ;"T" TAKE TELEVISON PICTURE. "αT" SIXBIT.
UNKNOWN ;"U"
NEWVRT ;"V" CREATE VERTEX AT CENTER, αV AT CURRENT VECTOR, βV ON NEW IMAGE
ADJUST ;"W" CENTER IN THE WINDOW.
XTEND ;"X" XTEND MODE COMMANDS
FLGR. ;"Y" DISPLAY RECIPROCAL ARC RADIALS.
[JUMPN 2,KILLER ;"Z" ZERO DATA BUFFERS.
OUTSTR[ASCIZ/USE XZERO
/]↔ POP0J]
NOP: CRLF
POP0J
FLGB.: SETCMM FLGBK ↔CRLF↔POP0J
FLGR.: SETZM FLGWED
MOVE CTRL↔AND META
JUMPN[SETOM FLGKINK↔GO .+8]↔SETZM FLGKINK
MOVEI 1↔MOVEM FLGRAR
SKIPE CTRL↔SETOM FLGRAR
SKIPE META↔SETZM FLGRAR
CALL(DPYIMG)↔CRLF↔POP0J
UNKNOW: OUTSTR[ASCIZ/??? TYPE 'XHELP' FOR A COMMAND SUMMARY.
/]
POP0J
;EXTENDED COMMANDS
XTEND: OUTSTR[ASCIZ/tend: /]
CALL(GETSIX)
XTEND2: MOVE 1,[XWD XTABLE-XJUMPS,XTABLE]
CAME (1)
AOBJN 1,.-1
JUMPGE 1,UNKNOWN
JRST @XJUMPS-XTABLE(1)
XTABLE: SIXBIT/XEROX/
SIXBIT/HELP/
SIXBIT/DDT/
SIXBIT/EXIT/
SIXBIT/ARCWID/
SIXBIT/DISPLA/
SIXBIT/-DISPL/
SIXBIT/KILVIC/
SIXBIT/GRID/
SIXBIT/-GRID/
SIXBIT/CAMERA/
SIXBIT/KILARC/
SIXBIT/CENTER/
SIXBIT/POPJ/
SIXBIT/BABYKI/
SIXBIT/SCALE/
SIXBIT/XSCALE/
SIXBIT/YSCALE/
SIXBIT/SLANT/
SIXBIT/SETKIN/
SIXBIT/MUNG/
SIXBIT/SORT/
SIXBIT/POLYGO/
SIXBIT/HOLE/
SIXBIT/READFO/
SIXBIT/ORTHMU/
SIXBIT/SETORT/
SIXBIT/FOURBI/
SIXBIT/SIXBIT/
SIXBIT/SHRINK/
SIXBIT/ZERO/
SIXBIT/CNTFLG/
SIXBIT/CLIP/
SIXBIT/NARROW/
SIXBIT/NARRW2/
; 012340123401234012340123401234012340123401234012340123401234012340123401234
; ASCII/,XEROX,HELP,DDT,EXIT,ARCWIDTH,DISPLAY,¬DISPLAY,KILVIC,GRID,¬GRID,CAMERA,KIL/
; ASCII/ARC,CENTER,POPJ,BABYKILLER,SCALE,XSCALE,YSCALE,SLANT,SETKINK,MUNG,SORT,POLY/
; ASCII/GON,HOLE,READFONT,ORTHMUNG,SETORTHCON,FOURBIT,SIXBIT,SHRINK,ZERO,CNTFLG,CLI
; ASCIZ/P,NARROW/
XJUMPS: TVXGP ;XEROX
COMHLP ;HELP
DDTGO ;DDT
[CALLI 12] ;EXIT
[CALL(REALIN)↔MOVEM ARCWID↔POP0J] ;ARCWID
[SETZM NODPY↔POP0J] ;DISPLAY
[SETOM NODPY↔POP0J] ;-DISPLAY
[PUSH P,FLGARC↔SETOM FLGARC ;KILVIC
PUSH P,FLGU↔SETOM FLGARC
HRRZ 1,FILM↔SON 1,1↔SON 1,1↔CALL(KILVIC,1)
CALL(ARCVIC,<1(P)>)
CALL(DPYIMG)↔CRLF
POP P,FLGU↔POP P,FLGARC↔POP0J]
[SETZM NOGRID↔CALL(DPYGRID)↔GO DPYBLK] ;GRID
[SETOM NOGRID↔CALL(DPYGRID)↔GO DPYBLK] ;-GRID
CAMERA ;CAMERA
[HRRZ 1,FILM↔SON 1,1↔SON 1,1
CALL(KLARCL,1)↔GO DPYIMG] ;KILARC
CENTER ;CENTER (AN ENTRY POINT TO ADJUST)
[POP P,(P)↔POPJ P,] ;POPJ (FOR RETURNING TO DDT)
FLGB. ;BABYKILL FLAG
[SETZM CTRL↔SETZM META↔GO SCALED+1] ;SCALE
[SETZM CTRL↔SETOM META↔GO SCALED+1] ;XSCALE
[SETOM CTRL↔SETZM META↔GO SCALED+1] ;YSCALE
[SETOM CTRL↔SETOM META↔GO SCALED+1] ;SLANT
SETKINK ;SETKINKCON
DOMUNG ;MUNG
IMGSRT ;SORT
[SKIPN 1,QBLK↔POP0J↔TEST 1,PBIT↔POP0J
MARK 1,HOLBIT] ;POLYGON
[SKIPN 1,QBLK↔POP0J↔TEST 1,PBIT↔POP0J
MARKZ 1,HOLBIT] ;HOLE
READFONT
[SKIPN 1,QBLK↔GO ORTHALL↔TEST 1,LBIT+PBIT↔POP0J ;ORTHMUNG
SON 1,1↔CALL(ORTHMUNG,1)↔GO DPYIMG]
[CALL(REALIN)↔FIX 0,207000↔MOVEM 0,ORTHCON↔POP0J] ;SETORTHCON
[SETZM FLGSIX↔SETZM FTVSIX↔POP0J] ;FOURBIT
[SETOM FLGSIX↔SETOM FTVSIX↔POP0J] ;SIXBIT
SHRINK ;SHRINK
KILLER ;ZERO
[SETCMM CNTFLG] ;CENTER FLAG
[OUTSTR[ASCIZ/BCLIP (/]
LDB [POINT 3,TVCLIP,20]↔ADDI "0"↔OUTCHR 0
OUTSTR[ASCIZ/): /]
CALL(REALIN)↔FIXX 0,↔DPB [POINT 3,TVCLIP,20]
OUTSTR[ASCIZ/TCLIP (/]
LDB [POINT 3,TVCLIP,23]↔ADDI "0"↔OUTCHR 0
OUTSTR[ASCIZ/): /]
CALL(REALIN)↔FIXX 0,↔DPB [POINT 3,TVCLIP,23]
POP0J] ;CLIP
[OUTSTR[ASCIZ/K = /]
CALL(REALIN)↔OUTSTR[ASCIZ/FOR EACH IMAGE? /]
CALL(SKIPYES)
GO [ HRRZ 1,FILM↔SON 1,1↔SON 1,1
CALL(NARROW,1,0)↔GO DPYIMG ] ;NARROW
MOVEM 0,NARRWK#
CALL(EACHLVL,[NARRW.])↔GO DPYIMG
NARRW.: CALL(NARROW,<-1(P)>,NARRWK)↔POP1J ]
[OUTSTR[ASCIZ/K1 = /] ;NARRW2
CALL(REALIN)
MOVEM 0,NARRWK
OUTSTR[ASCIZ/K2 = /]
CALL(REALIN)
MOVEM 0,NARRK2#
OUTSTR[ASCIZ/FOR EACH IMAGE? /]
CALL(SKIPYES)
GO [ HRRZ 1,FILM↔SON 1,1↔SON 1,1
CALL(NARRW2,1,NARRWK,NARRK2)↔GO DPYIMG ]
CALL(EACHLVL,[NARR2.])↔GO DPYIMG
NARR2.: CALL(NARRW2,<-1(P)>,NARRWK,NARRK2)↔POP1J ]
NSUBR COMHLP
CALL(TVHELP,[[SIXBIT/TVFONTDOC/↔0↔SIXBIT/XGPTVR/]])
POP0J
SUBREND COMHLP
NSUBR SMOOT.
SKIPE META
GO [ SETZM META
MOVE 1,FILM
SON 1,1
MOVEM 1,IMG0#
SM1: CALL(SMOOT.)
HRRZ 1,FILM
SON 2,1
CCW 2,2
SON. 2,1
CAME 2,IMG0
GO SM1
CRLF
CALL(SHRINK)
CALL(DPYIMG)
POP0J ]
HRRZ 1,FILM
SON 1,1 ;IMAGE
SON 1,1 ;LEVEL
PUSH P,FLGARC↔SETOM FLGARC
CALL(SMOOTH,1)
SKIPN CTRL ;KILL VIC TOO?
GO C1
; CALL(KILVIC,<1(P)>) ;YES, (AND STEAL ARG FROM STACK!)
CALL(ARCVIC,<1(P)>)
C1: PUSH P,FLGRAR↔MOVEI 1↔MOVEM FLGRAR
CALL(DPYIMG)↔POP P,FLGRAR
POP P,FLGARC↔POP0J]
SUBREND SMOOT.
NSUBR ORTHALL
MOVE 1,FILM
SON 1,1
JUMPE 1,[POPJ P,]
OUTSTR[ASCIZ/FOR EACH IMAGE? /]
CALL(SKIPYES)
SON 1,1
CALL(ORTHMU,1)
GO DPYIMG
SUBREND ORTHALL;12/8/72----------------------------------------------
SUBREND TTY;12/8/72----------------------------------------------
NSUBR TTYSAV
PUSHACS
CALL(TTY)
POPACS
POP0J
SUBREND TTYSAV;6-APR-73(TVR)-------------------------------------
NSUBR REGION
MOVE 1,FILM
SON 1,1
JUMPE 1,[POPJ P,]
SON 1,1
JUMPE 1,[POPJ P,]
PUSH P,1
PUSHJ P,MKBITS
GO DPYPAK
SUBREND REGION
NSUBR SEGTV
;GET THE OLD TVSEG.
SETZ↔SEGNUM
SKIPE 1,TVSEG
GO[ CAMN 0,1↔POP0J↔SKIPE↔DETSEG
ATTSEG 1,↔GO[FATAL(TVSEG ATTACH FAILURE.)]↔POP0J]
SKIPE↔DETSEG
;MAKE A NEW TVSEG.
MOVEI HI
CALLI 400015↔GO[FATAL(AIN'T NO CORE UP YONDER.)]
MOVE[SIXBIT/TVSEG/]↔CALLI 400036↔JFCL
SETZ↔SEGNUM↔MOVEM TVSEG
MOVE[XWD $,$+1]↔SETZM $↔BLT HI-1
MOVE[XWD HEAD,HEADER]↔BLT HEADER+9
POP0J
;OLDE TEN WORD TV PICTURE HEADER.
HEAD: 7↔0↔6↔=288↔=48↔=20↔=235↔=28↔=315↔=10368
SUBREND SEGTV;16/12/72---------------------------------------------
NSUBR(SEGFNT)------------------------------------------------------
;GET THE OLD FNTSEG.
SETZ↔SEGNUM
SKIPE 1,FNTSEG
GO[ CAMN 0,1↔POP0J↔SKIPE↔DETSEG
ATTSEG 1,↔GO[FATAL(FNTSEG ATTACH FAILURE.)]↔POP0J]
SKIPE↔DETSEG
;MAKE A NEW TVSEG.
MOVEI $+1777
CORE2↔GO[FATAL(AIN'T NO CORE UP YONDER.)]
MOVE[SIXBIT/FNTSEG/]↔SETNM2↔JFCL
SETZ↔SEGNUM↔MOVEM FNTSEG
POP0J
SUBREND SEGFNT;24-FEB-73(TVR)--------------------------------------
NSUBR KILLER
;BEGIN KILLER
SKIPE CTRL↔GO L
SKIPE META↔GO L2
SETZM QBLK
MOVE 1,[IOWD DATLEN,DATPDL]
MOVEM 1,DATPTR
MOVE OLD44↔CALLI 11↔JFCL↔SETZM OLD44
SETZM AVAIL↔SETZM BLKCNT↔SETZM FILM
CALL(MORCOR)
L: SETZM SX↔SETZM SY↔MOVE[32.0]↔MOVEM DEL↔MOVE[3.4]↔MOVEM MAG
L2: PGIOT 2,
CALL(CROP)↔CALL(DPYIMG)
CRLF↔POP0J
SUBREND;12/31/72-------------------------------------------------
NSUBR(GENKILL)
SKIPN 1,QBLK
POP0J
MOVE 2,BUCKY
TESTZ 1,VBIT↔ GO @[[CALL(KLVERT,1)↔POP0J↔GO G1]
[CALL(DEXTEND,1)↔GO G1]
[POP0J]
[POP0J]](2)
TESTZ 1,PBIT↔ GO [ CALL(KLPOLY,1)↔ GO G1 ]
TESTZ 1,IBIT↔ GO [ CALL(KILIMG,1)↔ GO G1 ]
G1: MOVEM 1,QBLK
G2: CALL(DPYIMG)
CRLF
POP0J
SUBREND
NSUBR(NEXIMG)-----------------------------------------------------
;BEGIN NEXIMG ;NEXT IMAGE - BGB - 11 DEC 72.
SKIPA
SETOM CTRL
MOVE 1,FILM
SON 2,1
HRRZ 3,(2)↔SKIPE CTRL↔HLRZ 3,(2)
SON. 3,1
CALL(DPYIMG)
SKIPE META↔GO[SNEAKS↔GO NEXIMG↔GO .+1]
CRLF
POP0J
SUBREND;12/11/72-------------------------------------------------
NSUBR(GETIMG)
ACCUMULATOR{IMG,IMG0,F,CHAR}
OUTSTR[ASCIZ/
CHARACTER: /]
INCHRW CHAR
MOVE F,FILM
SON IMG,F
MOVEM IMG,IMG0
LOOP: SON 1,IMG
NCNT 1,1
CAMN 1,CHAR
GO [ SON. IMG,F↔CALL(DPYIMG)
CRLF↔SETZM QBLK↔JUMPE 1,[POP0J]]
CCW IMG,IMG
CAME IMG,IMG0
GO LOOP
OUTSTR[ASCIZ/ --- NOT FOUND.
/]↔ POP0J
SUBREND GETIMG;14-MAR-72(TVR)
NSUBR(MAKCUT)-----------------------------------------------------
;BEGIN MAKCUT ; MAKE CUTS "C" COMMAND.
;CONTRAST DISPLAY CUT OFF COMMANDS.
MOVE 1,BUCKY
GO @[ L0
[MOVNS VCUT↔CALL(DPYIMG)↔POP0J]
[INCHRW↔ANDI 7↔LSH 3
INCHRW 1↔ANDI 1,7↔IOR 0,1↔MOVEM VCUT
CALL(DPYIMG)↔POP0J]
[MOVEI 1,'FNT'↔MOVEM 1,QQ3
OUTSTR[ASCIZ/CHARACTER = /]↔INCHRW QQ2↔GO L2A]
](1)
L0: TTYUUO 14,↔SNEAKW↔CAIN 15↔POP0J
;MAKE CUT COMMAND BEGINS HERE.
SETZM QQ2↔SETZM QQ3
L1: SETZ 1,↔INCHWL
CAIN 15↔GO[CALL(L3)↔GO L2]
CAIL 0,"0"↔CAILE 0,"7"↔GO[CALL(L3)↔GO L1]
IMULI 1,=8↔ANDI 17↔ADD 1,0↔GO L1+1
L2: INCHWL↔SKIPN 1↔POP0J
L2A: CALL(CRE,QQ2,QQ3)↔CALL(DPYIMG)↔CALL(SHRINK)
POP0J
DECLARE{QQ2,QQ3}
L3: SKIPN 1↔POP0J
CAIL 1,=64↔POP0J
MOVNS 1↔SETZ 3,
MOVSI 2,1B18↔LSHC 2,(1)
IORM 2,QQ2↔IORM 3,QQ3
POP0J
SUBREND;1/17/73--------------------------------------------------
NSUBR(GETSIX)-----------------------------------------------------
SETZ 0,
MOVE 2,[POINT 6,0]
MOVEI 3,6
GETSX1: INCHWL 1
CAIN 1,15
INCHWL 1
CAILE 1," "
CAILE 1,"z"
POP0J
SOJL 3,GETSX1
CAIL 1,"a"
SUBI 1,40
SUBI 1,40
IDPB 1,2
GO GETSX1
SUBREND GETSIX;26-FEB-73(TVR)
NSUBR(SKIPYES)
PUSH P,1
INCHRW 1
ANDI 1,137
CAIN 1,"Y"
AOS -1(P)
POP P,1
POP0J
SUBREND SKIPYES
NSUBR MKGLYPH ;MOVE POLYGON TO PREVIOUS IMAGE
ACCUMULATORS{A2,PG,LVL,IMG}
SKIPE META
GO [SKIPN 1,QBLK↔POP0J ;MIDPOINT
TEST 1,VBIT↔POP0J
SKIPE CTRL↔GO [CALL(MUNGV,1)↔CALL(DPYIMG)↔POP0J]
CALL(MIDPNT,1)↔GO L2]
MOVE PG,QBLK
TEST PG,PBIT
POP0J ;AIN'T POLYGON.
;DETACH QBLK POLYGON FROM ITS LEVEL.
CW 1,PG↔CCW 2,PG ;MOVEM 2,PGSAV#
CCW. 2,1↔CW. 1,2
CAMN 1,PG↔SETZ 1,
MOVEM 1,PGSAV# ;SO THAT WE DETECT EMPTY IMAGE
DAD LVL,PG↔SON 0,LVL
CAMN 0,PG↔SON. 1,LVL
;GET PREVIOUS IMAGE.
MOVE 1,FILM↔SON IMG,1↔MOVEM IMG,SAVIMG#
CW IMG,IMG
SON LVL,IMG
SKIPN CTRL↔GO L1
;MAKE NEW IMAGE WHEN CALLED FOR "αM".
SETQ(I,{MKIMAG,FILM})
SETQ(LVL,{MKLEVL,I,[-1]})
MOVE IMG,I#
SON. LVL,IMG
MOVE PG,QBLK
;PLACE THE POLYGON INTO THE IMAGE.
L1: DAD. PG,LVL ;DON'T FORGET TO POINT TO CORRECT LEVEL
CALL(RINGIN,PG,LVL)
MOVE 1,FILM↔MOVE 2,SAVIMG↔SON. 2,1
SKIPN PGSAV
GO [ SETZM QBLK
; OUTSTR[ASCIZ/KILLING NULL IMAGE.
;/]↔ CALL(KILIMG,2)
GO L2]
; MOVE PGSAV↔MOVEM QBLK
HRRZ 1,QBLK
SON 1,1 ;AND A RANDOM VERTEX
ROW 2,1
COL 1,1
CALL(CLOSEV,PGSAV,1,2)
SKIPN 1
SKIPA 1,PGSAV
PGON 1,1
L2: MOVEM 1,QBLK
CALL(DPYIMG)
CRLF
POP0J
SUBREND MKGLYPH;1/28/73--------------------------------------------------
NSUBR(ASCODE)-----------------------------------------------------
;BEGIN ASCODE ; ASSIGN ASCII CODE TO IMAGE.
MOVE 1,FILM↔SON 1,1↔SKIPN 1↔POP0J ;IMAGE
SON 1,1↔SKIPN 1↔POP0J ;LEVEL
OUTSTR[ASCIZ/ CHARACTER = /]
INCHRW↔HRRM 0,4(1)
CALL(DPYIMG)
CRLF
POP0J
SUBREND;2/1/73---------------------------------------------------
NSUBR(ADJUST)-----------------------------------------------------
;BEGIN ADJUST ;ADJUST CHARACTER LOCUS TO CENTER OF IMAGE.
ACCUMULATORS{IMG,LVL,PGN,V,R,C,IMG0,PGN0,V0}
SKIPE CTRL
GO [ SKIPN META
GO C0
SKIPN 1,QBLK
MOVE 1,FILM
CALL(LIGHTP,1)
MOVEM 1,CMIN
SUBI 2,=64*=216
MOVNM 2,RMAX
MOVE 1,FILM
SON IMG,1
CCW IMG0,IMG
SON LVL,IMG
SON PGN,LVL
MOVEM PGN,PGN0
SETZM CTRL
SETZM META
GO C2]
; SKIPN META
; GO C1
C0: SKIPN 1,QBLK
MOVE 1,FILM
JUMPE 1,[POP0J]
TESTZ 1,FILBIT
SON 1,1
TESTZ 1,LBIT
DAD 1,1
MOVE R,1
MOVE 2(1)
FOR @' TYPEε{IPV}
{ TLNE (<TYPE'BIT>)
GO C'TYPE
}
CALL(DPYBLK)
FATAL(UNKNOWN NODE - ADJUST)
CV: MOVE V,1
CCW V0,V
PGON 1,1
CP: MOVE PGN,1
CCW PGN0,PGN
DAD 1,1
DAD 1,1
CI: MOVE IMG,1
CCW IMG0,IMG
SETZM RMAX↔MOVEI =288⊗6↔MOVEM CMIN
MOVE 2(R)
TMP←←1
FOR @' TYPEε{IPV}
< TMP←←TMP+1
TLNE (TYPE'BIT)
GO CAT(L,→TMP)
>
FATAL(UNKNOWN NODE - ADJUST)
↑CENTER:SKIPN 1,FILM↔POP0J
SON IMG,1↔SKIPN IMG↔POP0J
MOVEM IMG,IMG0# ;FIRST IMAGE OF FILM
L2: SON LVL,IMG
SON PGN,LVL↔MOVEM PGN,PGN0# ;FIRST POLYGON OF IMAGE.
;FIND LOWERMOST AND LEFTMOST VERTICES OF THE IMAGE.
SETZM RMAX#↔MOVEI =288⊗6↔MOVEM CMIN#
L3: SON V,PGN
MOVEM V,V0# ;FIRST VECTOR OF THIS POLYGON.
L4: ROW R,V↔CAML R,RMAX↔MOVEM R,RMAX
COL C,V↔CAMG C,CMIN↔MOVEM C,CMIN
CCW V,V↔CAME V,V0↔GO L4
CCW PGN,PGN↔CAME PGN,PGN0↔GO L3
;RELOCATE IMAGE.
C2: MOVE RMAX↔ADDI 40↔ANDCMI 77↔SUBI =108⊗6↔MOVNM RMAX
MOVE CMIN↔ADDI 40↔ANDCMI 77↔SUBI =144⊗6↔MOVNM CMIN
SKIPN CTRL
SKIPE META
GO [ MOVE 1,1(P)
SKIPN CTRL
SETZM RMAX
SKIPN META
SETZM CMIN
GO L5 ]
L5: SON V,PGN↔MOVEM V,V0
L6: ROW R,V↔ADD R,RMAX↔ROW. R,V
COL C,V↔ADD C,CMIN↔COL. C,V
CCW V,V↔CAME V,V0↔GO L6
CCW PGN,PGN↔CAME PGN,PGN0↔GO L5
;NEXT IMAGE.
CCW IMG,IMG↔CAME IMG,IMG0↔GO L2
CALL(DPYIMG)
CRLF
POP0J
SUBREND;1/28/73--------------------------------------------------
NSUBR(SCALED)-----------------------------------------------------
;BEGIN SCALED ;CHANGE SCALE OF ALL IMAGES.
ACCUMULATORS{IMG,LVL,PGN,V,R,C,K1,K2,SLANT}
TDZA 1,1
SETO 1,
MOVEM 1,FORALL#
OUTSTR[ASCIZ/ K = /]
CALL(REALIN)
JUMPE [POPJ P,]
L1: MOVEM K1↔MOVEM K2
MOVE[1.0]
MOVE SLANT,CTRL↔AND SLANT,META
SKIPE SLANT↔SETZM META
SKIPE CTRL↔MOVEM K2
SKIPE META↔MOVEM K1
SKIPN 1,FILM↔POP0J
SON IMG,1↔SKIPN IMG↔POP0J
MOVEM IMG,IMG0# ;FIRST IMAGE OF FILM
L2: SON LVL,IMG
PGON 1,LVL↔FLO 1,↔FMPR 1,K2 ;UPDATE WIDTH
FIX 1,225000↔PGON. 1,LVL
SON PGN,LVL↔MOVEM PGN,PGN0# ;FIRST POLYGON OF IMAGE.
JUMPE PGN,L7A
L5: SON V,PGN↔MOVEM V,V0#
L6: ROW R,V↔FLO R,↔MOVNS R↔FAD R,[108.0]↔FMP R,K1
COL C,V↔FLO C,↔FSB C,[144.0]↔FMP C,K2
JUMPN SLANT,[FADR C,R↔GO L7]
MOVE[108.0]↔FSB R↔FIX 225000↔ROW. 0,V
L7: FAD C,[144.0]↔FIX C,225000↔COL. C,V
CCW V,V↔CAME V,V0↔GO L6
CCW PGN,PGN↔CAME PGN,PGN0↔GO L5
;NEXT IMAGE.
L7A: CCW IMG,IMG↔SKIPN FORALL↔GO L8↔CAME IMG,IMG0↔GO L2
L8: CALL(DPYIMG)
POP0J
↑SCALER: SETZM FORALL↔MOVE 0,ARG1↔CALL(L1)↔POP1J
SUBREND;1/28/73--------------------------------------------------
NSUBR FOREACH,OBJ,ROUTINE
;BEGIN FOREACH
HRRZ 1,OBJ
LOOP: PUSH P,1
SON 1,1
CALL(ROUTINE,1)
POP P,1
CCW 1,1
CAME 1,OBJ
GO LOOP
POP2J
SUBREND FOREACH;25-FEB-73(TVR)
;_________________________________________________________________
NSUBR EACHLVL,ROUTINE
MOVE 1,FILM
SON 1,1
JUMPE 1,POP1J.
MOVEM 1,IMG0#
LOOP: SON 1,1
JUMPE 1,POP1J.
CALL(@ROUTINE,1)
MOVE 2,FILM
SON 1,2
JUMPE 1,POP1J.
CCW 1,1
SON. 1,2
CAME 1,IMG0
GO LOOP
POP1J
SUBREND EACHLVL;19-APR-73(TVR)
NSUBR DOMOVE,X,Y
;BEGIN DOMOVE
ACCUMULATORS{DX,DY}
MOVE 1,DEL
SKIPE CTRL↔FMPRI 1,(2.0)
SKIPE META↔FMPRI 1,(4.0)
MOVE DX,1↔FMPR DX,-2(P)
MOVE DY,1↔FMPR DY,-1(P)
SKIPN 1,QBLK↔GO[ FADRM DX,SX↔FADRM DY,SY
CALL(CROP)↔CALL(DPYIMG)↔POP2J]
; TESTZ 1,VBIT ;IF VECTOR, USE DEL/8
; GO [ FMPRI DX,(0.125)
; FMPRI DY,(0.125)
; GO L1 ]
L1: FIX DX,225000↔FIX DY,225000
CALL(XYMOVE,1,DX,DY)
MOVE 1,QBLK
TEST 1,VBIT↔GO [ CALL(DPYIMG)↔POP2J ] ;IS IT A VERTEX
PGON 2,1↔SON 0,2
PUSH P,1
; CAME 0,1↔POP2J ;RETURN IMMEDIATELY IF NOT SON
CALL(FNDPSON,2) ;FIND NEW SON
CALL(INCDPY) ;UPDATE DISPLAY (ARG ALREADY ON STACK)
POP2J
SUBREND DOMOVE;16-FEB-73------------------------------------------
NSUBR(XYMOVE,OBJ,DELTAX,DELTAY)-----------------------------------
ACCUMULATOR{DX,DY,X,Y,T}
MOVE DX,DELTAX↔MOVE DY,DELTAY
HRRZ 1,OBJ↔JUMPE 1,POP3J.
TESTZ 1,VBIT
GO [ COL X,1↔ADD X,DX↔COL. X,1
ROW Y,1↔ADD Y,DY↔ROW. Y,1
POP3J]
SON 1,1↔CALL(XYMOV1,1)↔POP3J
SUBREND XYMOVE;16-FEB-73------------------------------------------
NSUBR(XYMOV1,OBJ)-------------------------------------------------
;BEGIN XYMOV1
ACCUMULATOR{DX,DY,X,Y,T}
HRRZ 1,-1(P)↔ JUMPE 1,POP1J.
TYPE T,1↔ TRNE T,(VBIT)
GO ADDPOS
LOOP: PUSHP 1
SON 1,1
CALL(XYMOV1,1)
POPP 1
CCW 1,1
CAME 1,OBJ
GO LOOP
POP1J
; CALL(FOREACH,1,[XYMOV1])↔ POP1J
ADDPOS: HRRZ T,1
COL X,T↔ADD X,DX↔COL. X,T
ROW Y,T↔ADD Y,DY↔ROW. Y,T
CCW 1,1↔CAME 1,OBJ↔GO ADDPOS
POP1J
SUBREND XYMOV1;16-FEB-73------------------------------------------
NSUBR(CLOSEV,OBJ,AX,AY) FIND CLOSEST VERTEX TO (AX,AY) FROM OBJ
CLOSE←1
ACCUMULATORS{CLOSE2,VAL,VAL2,X,Y,DX,DY,T,SKPOBJ}
MOVE SKPOBJ,OBJ
MOVE X,AX
MOVE Y,AY
SETZB CLOSE,CLOSE2
MOVE VAL,[377777777777]
MOVE VAL2,VAL
CALL(CLSCW,OBJ)
POP3J
SUBREND
NSUBR(CLSCCW,OBJ)
CLOSE←1
ACCUMULATORS{CLOSE2,VAL,VAL2,X,Y,DX,DY,T,SKPOBJ,FOO,OPERATION}
SKIPA OPERATION,[CCW T,T]
↑CLSCW: MOVE OPERATION,[CW T,T]
HRRZ T,OBJ
TESTZ T,VBIT
GO V
PUSH P,OBJ
LOOP: CAMN T,SKPOBJ
GO CONT
PUSH P,T
SON T,T
CALL(CLSCW,T)
POP P,T
CONT: XCT OPERATION
CAME T,(P)
GO LOOP
POP P,(P)
POP1J
V: SETZ FOO, ;CLEAR FOUND FLAG
VLOOP: CAMN T,SKPOBJ
GO VCONT
COL DX,T ;DISTANCE↑2 = (X-X0)↑2+(Y-Y0)↑2
SUB DX,X
IMUL DX,DX
ROW DY,T
SUB DY,Y
IMUL DY,DY
ADD DX,DY
CAML DX,VAL
GO VCONT
TEST SKPOBJ,VBIT ;IF NOT VERTEX, REMEMBER ONLY ONE VERTEX
JUMPN FOO,V2 ;PER POLYGON BUT PICK CLOSEST POINT
MOVE CLOSE2,CLOSE
MOVE VAL2,VAL
SETO FOO, ;WE HAVE FOUND A POINT
V2: MOVE CLOSE,T
MOVE VAL,DX
VCONT: XCT OPERATION
CAME T,OBJ
GO VLOOP
POP1J
SUBREND CLSCCW;19-FEB-73(TVR)-------------------------------------
NSUBR(FINDV)
CLOSE←1
ACCUMULATORS{CLOSE2,VAL,VAL2,X,Y,DX,DY,T,SKPOBJ}
SKIPN 1,QBLK
POP0J
F1: TEST 1,VBIT
GO [ SON 1,1↔ GO F1]
SKIPE CTRL
SKIPN META
GO [ COL X,1
ROW Y,1
GO USEQ]
CALL(LIGHTP,1)
MOVE X,1↔MOVE Y,2
SETZM CTRL↔SETZM META
USEQ: PUSH P,QBLK
MOVSI VAL,377777
SETZB CLOSE,CLOSE2
MOVE SKPOBJ,QBLK
SKIPE META
GO [ CALL(CLSCCW)
GO OK]
CALL(CLSCW)
SKIPN CTRL
GO OK2
OK: SKIPN 2
MOVE 1,2
OK2: JUMPE 1,[POP0J]
MOVE 2,QBLK
TESTZ 2,PBIT
PGON 1,1
MOVEM 1,QBLK
CALL(DPYIMG)
POP0J
SUBREND FINDV;
NSUBR(MIDPNT,VERTEX)
ACCUMULATORS{V0,V2,T1}
V1←1
MOVE V0,VERTEX
TEST V0,VBIT
GO [ FATAL(NOT A VERTEX AT MIDPNT) ]
CCW V2,V0
SETQ(V1,{MAKE,0}) ;MAKE SAME TYPE AS V0
ROW 0,V0↔ROW T1,V2↔ADD 0,T1↔ASH 0,-1↔ROW. 0,V1
COL 0,V0↔COL T1,V2↔ADD 0,T1↔ASH 0,-1↔COL. 0,V1
CW. V0,V1↔CW. V1,V2
CCW. V2,V1↔CCW. V1,V0
PGON T1,V0↔PGON. T1,V1
AOS 4(T1)
POP1J
SUBREND MIDPNT
NSUBR(MUNGV,VERTEX)
HRRZ 1,VERTEX
TEST 1,VBIT
GO [ FATAL(NOT A VERTEX AT MUNG) ]
COL 0,1↔ADDI 0,40↔ANDCMI 0,77↔COL. 0,1
ROW 0,1↔ADDI 0,40↔ANDCMI 0,77↔ROW. 0,1
POP1J
SUBREND MUNGV
NSUBR DOMUNG
ACCUMULATORS{V,V0}
SKIPN 1,QBLK
POP0J
MUNG2: TESTZ 1,IBIT
SON 1,1
TESTZ 1,LBIT
GO [ SON 1,1
MOVEM 1,PGN0#
PLOOP: MOVEM 1,PGN#
CALL(MUNG2)
MOVE 1,PGN#
CCW 1,1
CAME 1,PGN0
GO PLOOP
GO DPYIMG ]
TEST 1,PBIT
POP0J
SON V,1
SON V0,1
LOOP: CALL(MUNGV,V)
CCW V,V
CAME V,V0
GO LOOP
CALL(DPYIMG)
POP0J
SUBREND DOMUNG
NSUBR(NEWVRT)
ACCUMULATORS{T1,V2,IMG,LVL,PG,V} ;T1 AND V2 GET CLOBBERED IN RINGIN
;FIX NCNT SOMETIME
SKIPE CTRL↔GO ADDLIN
SETQ(V,{MAKE,[VBIT+VREL]})
CCW. V,V↔CW. V,V ;VERTEX RING AT
CALL(RCXY,[0],[0]) ;CENTER OF SCREEN
COL. 1,V↔ROW. 2,V
MOVE 0,[PBIT+PGNREL]
OUTSTR[ASCIZ/Is this is polygon to be hole? /]
CALL(SKIPYES)
TLO 0,(HOLBIT)
SETQ(PG,{MAKE,0}) ;MAKE A NEW POLYGON
SON. V,PG↔PGON. PG,V ;LINK TO VERTEX
SKIPN META↔GO [ MOVE 1,FILM
SON IMG,1 ;GET THIS IMAGE
JUMPE IMG,MAKNEW
SON LVL,IMG
GO NOTNEW ]
MAKNEW: SETQ(I#,{MKIMAG,FILM})
SETQ(LVL,{MKLEVL,I,[-1]})
NOTNEW: CALL(RINGIN,PG,LVL)
DAD. LVL,PG ;PUT LEVEL INTO POLYGON
MOVEM V,QBLK ;DISPLAY NEW VERTEX
GO FIN
ADDLIN: SKIPN V,QBLK↔POP0J
TEST V,VBIT↔POP0J
CALL(MAKE,[VBIT+VREL]) ;MAKE A VERTEX
MOVE 0,1(V)↔MOVEM 0,1(1) ;COPY OLD ROW & COL
PGON PG,V↔PGON. PG,1 ;AND OWNER
CCW V2,V
CW. V,1↔CW. 1,V2
CCW. V2,1↔CCW. 1,V
MOVEM 1,QBLK ;SO WE CAN REFERENCE IT
CALL(FNDPSON,PG) ;FIND UPPER LEFT
FIN: CALL(DPYIMG)
CRLF
POP0J
SUBREND NEWVRT
NSUBR(ROTPOLY,POLYGON,ANGLE,CX,CY)
ACCUMULATORS{X,Y,V,V0,S,C}
MOVE 1,POLYGON
TEST 1,PBIT
GO [ FATAL(NOT A POLYGON AT ROTPOLY)]
CALL(SIN,ANGLE)
MOVEM 1,S
CALL(COS,ANGLE)
MOVEM 1,C
MOVE 1,POLYGON
SON V,1
MOVEM V,V0
LOOP: COL X,V↔SUB X,CX↔FLOAT X,
ROW Y,V↔SUB Y,CY↔FLOAT Y,
MOVE 0,X↔MOVN 1,Y
FMPR 0,C↔FMPR 1,S↔FADR 0,1
FMPR Y,C↔FMPR X,S↔FADR Y,X
FIXX 0,↔FIXX Y,
ADD 0,CX↔ADD Y,CY
COL. 0,V↔ROW. Y,V
CCW V,V
CAME V,V0
GO LOOP
CALL(FNDPSON,POLYGON)
CALL(KLARCP,POLYGON)
POP4J
SUBREND ROTPOLY;14-MAR-73(TVR)
NSUBR(DOROT)
SKIPN 10,QBLK
POP0J
TEST 10,IBIT+LBIT+PBIT
POP0J
OUTSTR[ASCIZ/Rotation = /]
CALL(REALIN)
MOVEM 0,ROTCON#
TESTZ 10,PBIT
GO [ CALL(PCENTER,10)
CALL(ROTPOLY,QBLK,ROTCON,1,2)
GO FIN ]
TESTZ 10,IBIT
SON 10,10
SON 10,10
MOVEM 10,PGN0#
CALL(RCXY,[0],[0])
MOVEM 1,CX#
MOVEM 2,CY#
LOOP: CALL(ROTPOLY,10,ROTCON,CX,CY)
CCW 10,10
CAME 10,PGN0
GO LOOP
FIN: CRLF
CALL(DPYIMG)
POP0J
SUBREND DOROT;14-MAR-73(TVR)
NSUBR(PCENTER,POLYGON)
ACCUMULATORS{Y,CNT,X,V,V0}
MOVE 1,POLYGON
SON V0,1
MOVE V,V0
SETZB X,Y
MOVEI CNT,1
LOOP: COL 1,V↔ADD X,1
ROW 1,V↔ADD Y,1
CCW V,V
CAME V,V0
AOJA CNT,LOOP
IDIV X,CNT
IDIV Y,CNT
MOVE 1,X ;RETURN X IN 1 AND Y IN 2
POP1J
SUBREND PCENTER;14-FEB-73(TVR)
NSUBR IMGSRT
ACCUMULATORS{I0,I1,I2,I3,A1,A2}
CALL(IMAGE1)
;SET UP IMAGE POINTERS
MOVE I1,1
CW I0,I1
CCW I2,1
CCW I3,I2
MOVEM I1,IMG0#
SON A2,I2
NCNT A2,A2
OUTSTR[ASCIZ/Sorting/]
RETRY: SETZM FOOFLG#
MOVEI 1,=2048
LOOP: MOVE 0,[XWD I1,I0] ;ADVANCE BY BLT'ING
BLT 0,A1
CCW I3,I2 ;AND CHANGING I3 AND A2
SON A2,I2
NCNT A2,A2
SOJL 1,[ FATAL(IMAGE RING NOT CONNECTED!!!) ]
CAMG A1,A2
GO COMPOK
EXCH I1,I2↔EXCH A1,A2
CW. I0,I1↔CW. I1,I2↔CW. I2,I3 ;CHANGE POINTERS
CCW. I3,I2↔CCW. I2,I1↔CCW. I1,I0
SETOM FOOFLG
COMPOK: CAME I3,IMG0 ;DONE WITH LOOP YET?
GO LOOP ;NO
SKIPN FOOFLG ;ARE WE SORTED YET
GO FINISH ;YES, RETURN AFTER DISPLAYING
OUTCHR["."]
MOVE 0,[XWD I1,I0] ;ADVANCE BY BLT'ING
BLT 0,A1
CCW I3,I2 ;AND CHANGING I3 AND A2
SON A2,I2
NCNT A2,A2
GO RETRY ;CLEAR OUT OF SEQUENCE FLAG AND RETRY
FINISH: OUTSTR[ASCIZ/Sorted!
/]↔ CALL(DPYIMG)
POP0J
SUBREND IMGSRT
NSUBR IMAGE1
ACCUMULATORS{T1,MINIMG}
HRRZ 1,FILM
SON 1,1
SON T1,1
NCNT 0,T1
MOVEM 1,MINIMG
LOOP: CCW 1,1
SON T1,1
NCNT T1,T1
CAML T1,0
GO [ CAME 1,MINIMG↔GO LOOP
MOVE 1,MINIMG↔POP0J ]
MOVEM 1,MINIMG
MOVE 0,T1
GO LOOP
SUBREND IMAGE1
NSUBR READFONT
SKIPL META
SETOM CHRCOD#
LOOP: AOS 1,CHRCOD
OUTCHR CHRCOD
CAILE 1,177
POP0J
CALL(SEGFNT)
MOVE 1,CHRCOD
SKIPG $(1)
GO LOOP
CALL(CRE,1,['FNT'])
GO LOOP
SUBREND READFONT
NSUBR PUSHDAT,VAL
EXCH 1,VAL
EXCH 16,DATPTR
PUSH 16,1
EXCH 16,DATPTR
EXCH 1,VAL
POP1J
SUBREND PUSHDAT
NSUBR POPDAT
EXCH 16,DATPTR
POP 16,1
EXCH 16,DATPTR
POP0J
SUBREND POPDAT
NSUBR LIMITS,LEVEL
XMIN←1
ACCUMULATORS{XMAX,YMIN,YMAX,V0,V,PGN,LVL}
MOVE LVL,LEVEL
TEST LVL,LBIT
GO [ FATAL(NOT A LEVEL AT LIMITS) ]
SON PGN,LVL↔JUMPE PGN,[ZRET: SETZB 1,2↔SETZB 3,4↔POP1J]
SON V,PGN
COL XMIN,V↔COL XMAX,V
ROW YMIN,V↔ROW YMAX,V
MOVEM LVL,LVL0#
LLOOP: SON PGN,LVL↔MOVEM PGN,PGN0#
PLOOP: SON V,PGN↔MOVEM V,V0
VLOOP: COL 0,V↔CAMGE 0,XMIN↔MOVE XMIN,0↔CAMLE 0,XMAX↔MOVE XMAX,0
ROW 0,V↔CAMGE 0,YMIN↔MOVE YMIN,0↔CAMLE 0,YMAX↔MOVE YMAX,0
CCW V,V↔CAME V,V0↔GO VLOOP
CCW PGN,PGN↔CAME PGN,PGN0↔GO PLOOP
CCW LVL,LVL↔CAME LVL,LVL0↔GO LLOOP
POP1J
SUBREND LIMITS
NSUBR DEXTEND,VERTEX
ACCUMULATORS{T3,DX1,DX2,DY1,DY2,X1,X2,X3,X4,Y1,Y2,Y3,Y4}
T1←0
T2←1
COMMENT ⊗ This routine deletes the line segment defined by VERTEX
and extendes the line segments which connected it.
v2\ /v4
\ /
\_____/
v1 . .v3
. .
.
vn
(X3 Y4 - X4 Y3) (Y2 - Y1) + (X2 Y1 - X1 Y2) (Y4 - Y3)
Yn = -----------------------------------------------------
(X2 - X1) (Y4 - Y3) - (X4 - X3) (Y2 - Y1)
X2 (Yn - Y1) - X1 (Yn - Y2)
Xn = ---------------------------
Y2 - Y1
(EQUATIONS COURTOUSY OF MIT MATHLAB)
⊗;
MOVE 1,VERTEX
TEST 1,VBIT
GO [ FATAL(NOT A VERTEX AT DEXTEND) ]
CW 2,1
CCW 3,1
CCW 4,3
CAME 1,QBLK
MOVEM 3,QBLK
FOR @' I←1,4
< COL X'I,I
ROW Y'I,I
FLO X'I,
FLO Y'I,
>
MOVE DX1,X2 ;(I HATE COMPILING ARITHMETIC EXPRESSIONS INTO
FSBR DX1,X1 ;MACHINE CODE, BUT THERE IS NO GOOD HIGHER LEVEL
MOVE DX2,X4 ;LANGUAGE HERE WHICH WILL GENERATE GOOD ENOUGH
FSBR DX2,X3 ;CODE FOR BOTH THE ARITHMETIC AND DATA STRUCTURE
MOVE DY1,Y2 ;MANIPULATION. SORRY IF YOU HAVE TO READ THIS
FSBR DY1,Y1 ;CODE).
MOVE DY2,Y4
FSBR DY2,Y3
MOVE T1,X4
FMPR T1,Y3
MOVE T2,X3
FMPR T2,Y4
FSBR T2,T1
FMPR T2,DY1
MOVE T3,X1
FMPR T3,Y2
MOVE T1,X2
FMPR T1,Y1
FSBR T1,T3
FMPR T1,DY2
FADR T1,T2
MOVE T2,DX2
FMPR T2,DY1
MOVE T3,DX1
FMPR T3,DY2
FSBR T3,T2
FDVR T1,T3
MOVE T2,T1
FSBR T2,Y2
FMPR T2,X1
MOVE T3,T1
FSBR T1,Y1
FMPR T1,X2
FSBR T1,T2
FDVR T1,DY1
MOVE T2,VERTEX
CCW T2,T2
FIX T1,225000
FIX T3,225000
COL. T1,T2
ROW. T3,T2
PUSHP T2
CALL(KLvERT,VERTEX)
GO [ FATAL(CAN'T KILL VERTEX) ]
POPP 1
POP1J
SUBREND DEXTEND
NSUBR NARROW,LVL,K
ACCUMULATORS{DEL,DC1,DC2,DR1,DR2,C1,C2,R1,R2,V1,V2,VT,PGN}
EXTERNAL REVHOL,RSTHOL,SQRT
CALL REVHOL,LVL
MOVE 1,LVL
SON PGN,1
MOVEM PGN,PGN0#
PLOOP: SON V1,PGN
MOVEM V1,VT
CCW V2,V1
ROW R2,V2
COL C2,V2
ROW DR2,V1
SUBM R2,DR2
COL DC2,V1
SUBM C2,DC2
FLO DR2,
FLO DC2,
VLOOP: MOVE 0,[XWD DC2,DC1]
BLT 0,V1
CCW V2,V1
ROW R2,V2
COL C2,V2
MOVE DR2,R2
MOVE DC2,C2
SUB DR2,R1
SUB DC2,C1
FLO DR2,
FLO DC2,
FADR DR1,DR2
FADR DC1,DC2
CALL VECMAG,DR1,DC1
MOVE DEL,K
FDVR DEL,1
MOVN 1,DEL
FMPR 1,DC1
FIX 1,233000
ROW 0,V1
ADD 0,1
ROW. 0,V1
MOVE 1,DEL
FMPR 1,DR1
FIX 1,233000
COL 0,V1
ADD 0,1
COL. 0,V1
CAME V1,VT
GO VLOOP
CCW PGN,PGN
CAME PGN,PGN0
GO PLOOP
CALL RSTHOL,LVL
POP2J
SUBREND NARROW
NSUBR NARRW2,LVL,K1,K2
ACCUMULATORS{DEL,DC1,DC2,DR1,DR2,C1,C2,R1,R2,V1,V2,VT,PGN}
EXTERNAL REVHOL,RSTHOL,SQRT
CALL REVHOL,LVL
MOVE 1,LVL
SON PGN,1
MOVEM PGN,PGN0#
PLOOP: SON V1,PGN
MOVEM V1,VT
CCW V2,V1
ROW R2,V2
COL C2,V2
ROW DR2,V1
SUBM R2,DR2
COL DC2,V1
SUBM C2,DC2
FLO DR2,
FLO DC2,
CALL VECMAG,DC2,DR2
FDVR DC2,1
FDVR DR2,1
VLOOP: MOVE 0,[XWD DC2,DC1]
BLT 0,V1
CCW V2,V1
ROW R2,V2
COL C2,V2
MOVE DR2,R2
MOVE DC2,C2
SUB DR2,R1
SUB DC2,C1
FLO DR2,
FLO DC2,
CALL VECMAG,DC2,DR2
FDVR DC2,1
FDVR DR2,1
FADR DR1,DR2
FADR DC1,DC2
MOVN 1,K1
FMPR 1,DC1
FIX 1,233000
ROW 0,V1
ADD 0,1
ROW. 0,V1
MOVE 1,K2
FMPR 1,DR1
FIX 1,233000
COL 0,V1
ADD 0,1
COL. 0,V1
CAME V1,VT
GO VLOOP
CCW PGN,PGN
CAME PGN,PGN0
GO PLOOP
CALL RSTHOL,LVL
POP3J
SUBREND NARRW2
NSUBR VECMAG,DX,DY
MOVE 0,DX
FMPR 0,0
MOVE 1,DY
FMPR 1,1
FADR 0,1
CALL(SQRT,0)
POP2J
SUBREND VECMAG